home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mapl0831.zip / ANSICHAT.BAS < prev    next >
BASIC Source File  |  1992-08-30  |  14KB  |  323 lines
  1. ' $title: 'ANSIChat Split Screen Chat for RBBS-PC v17.4'
  2. '          By Dan Drinnon 8:903/2 1:313/6
  3. '              The Cellar Door RBBS (505) 763-1795 9600 v32
  4. '             Scott McNay 1:395/11
  5. '              The Wizard II RBBS   (817) 554-5331 9600 V32b, V42b
  6. '
  7. '          Copyright (c) 1992 by Daniel T. Drinnon   All Rights Reserved
  8. '
  9. '          DO NOT Distribute in Modified Form!
  10. '
  11. 'REVISIONS:
  12. '1.00  -  06-28-92 Initial Release
  13. '1.01  -  06-29-92 Fix for F2 Shell to DOS from ANSICHAT
  14. '1.02  -  07-04-92 Prevent F10 from Loading another ANSIChat
  15. '                  Keep ANSIChat from showing 'RBBS' if that is already
  16. '                  part of the BBS name.
  17. '                  added support for Sysop's PgUp/PgDn (RBBSSUB3.BAS)
  18. '                  combined local and remote input routines
  19. '1.03  -  07-09-92 Greater control over ANSI colors independent of RBBS colors
  20. '1.04  -  07-13-92 Added control to keep ANSICHAT from popping up when
  21. '                  the sysop does not have ANSI installed according to
  22. '                  CONFIG.
  23. '1.05  -  07-19-92 Modified RBBSSUB3 to get status of ANSIChat Capability
  24. '                  in DRSTx.DEF after return from a DOOR.
  25. '                  Removed redundant code in RBBS-PC.BAS.
  26. '                  Included ANSIFUN - a mod to make a Ring instead of a BEEP
  27. '                  for Sysop Page.
  28. '1.06  -  07-04-92 Gave the remote the option to terminate the chat by
  29. '                  pressing ESC.
  30. '1.07  -  08-10-92 Fixed BackSpace routine to properly locate the cursor.
  31. '1.08  -  08-13-92 Fixed the wordwrap/color mix problem and tweaked the
  32. '                  ANSI commands and a couple other things to speed up
  33. '                  the I/O.
  34. '1.09  -  08-18-92 Changed the bottom line of the remote screen to not go
  35. '                  past line 23.
  36. '                  Changed ZIP distribution file name to ACHATxxx.ZIP where xxx
  37. '                  denotes the version number.
  38. '1.10  -  08-26-92 Removed "STATIC" from SUB headers to force string space to
  39. '                  be released after use.
  40. '                  Added GetUserScreenSize sub to determine user's screen size
  41. '                  so that screen layout can be determined dynamically.  Makes
  42. '                  ANSIChat more compatible with non-standard (25x80) screens.
  43. '                  Changed exit method to require ESC key to be pressed twice.
  44. '                  This is compatible with ANSIED, and prevents accidents when
  45. '                  user hits a cursor key.
  46. '
  47. ' $INCLUDE: 'RBBS-VAR.MOD'
  48. '
  49. ' $SUBTITLE: 'ANSIChat - ANSI Split Screen Chat Routine'
  50. '
  51. ' $PAGE
  52. '
  53. '  SUBROUTINE NAME    -- ANSIChat
  54. '
  55. '  INPUT PARAMETERS   -- None
  56. '
  57. '  OUTPUT PARAMETERS  -- None
  58. '
  59. '  SUBROUTINE PURPOSE -- Allows Split Screen ANSI Chat for RBBS
  60. '
  61. '
  62. DIM ANSIRow(1), ANSICol(1), ACColor$(1), HoldInput$(1), StartRow(1)
  63. DIM MaxRow(1), WasX$(1), LastChar$(1)                                ' 1.10
  64.  
  65. Common Shared ANSIRow(), ANSICol(), ACColor$(), HoldInput$(), StartRow()
  66. Common Shared MaxRow(), WasX$(), LastChar$()                         ' 1.10
  67. Common Shared LocalOut, RemoteOut, SideOut
  68. Common Shared MenuColor1$, MenuColor2$
  69. Common Shared RowMax, ColMax, RowMid                                 ' 1.10
  70. '
  71. 1000 SUB ANSIChat
  72. '
  73.      LocalOut = 0
  74.      RemoteOut = 1
  75.      SideOut = LocalOut
  76.      TimeChatStarted! = TIMER                                        ' 1.10
  77.      CALL GetUserScreenSize                                          ' 1.10
  78.      ANSIRow(LocalOut) = 2
  79.      ANSIRow(RemoteOut) = RowMid + 2                                 ' 1.10
  80.      ANSICol(LocalOut) = 1
  81.      ANSICol(RemoteOut) = 1
  82.      ACColor$(LocalOut) = "32;40m"                              ' 1.08
  83.      ACColor$(RemoteOut) = "33;40m"                             ' 1.08
  84.      ZWasCM = ZTrue
  85.      ZSubParm = 1
  86.      HoldColorReset$ = ZColorReset$
  87.      MenuColor1$ = "33;44m"                                     ' 1.08
  88.      MenuColor2$ = "36;44m"                                     ' 1.08
  89.      ZColorReset$ = MenuColor2$                                      ' 1.03
  90.      CALL ANSIMenu
  91.      CALL ANSILocate (ANSIRow(LocalOut),ANSICol(LocalOut))
  92.      CALL QuickTPut1 (ACColor$(LocalOut) + ZSysopGreeting$)
  93.      CALL SplitScreenChat
  94.      ZWasCM = 0
  95.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  96.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  97.      IF NOT ZLocalUser THEN _
  98.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  99.      CALL ClearANSIScreen
  100.      CALL QuickTPut(ZEmphasizeOff$ + ZCrLF$ + _                      ' 1.08
  101.           "Chat over.  BBS resuming",1)                              ' 1.08
  102.      ZColorReset$ = HoldColorReset$
  103.      END SUB
  104. '
  105. 4000 SUB ANSIMenu
  106. '
  107.      LineBar$ = STRING$(80,177)                                      ' 1.08
  108.      CALL ClearANSIScreen
  109.      CALL ANSILocate (1,1)
  110.      CALL QuickTPut (MenuColor2$ + LineBar$,0)                       ' 1.03
  111.      IF INSTR(ZRBBSName$,"BBS") <> 0 THEN _                          ' 1.02
  112.         ZOutTxt$ = "░*>>> " + ZRBBSName$ + " ANSI Chat <<<*░" _      ' 1.02
  113.      ELSE _                                                          ' 1.02
  114.         ZOutTxt$ = "░*>>> " + ZRBBSName$ + " RBBS ANSI Chat <<<*░"   ' 1.02
  115.      temppos = (40 - (LEN(ZOutTxt$)/2))
  116.      CALL ANSILocate (1,temppos)
  117.      CALL QuickTPut (MenuColor1$ + ZOutTxt$,0)                       ' 1.03
  118.      CALL ANSILocate (RowMid + 1,1)                                  ' 1.10
  119.      CALL QuickTPut (MenuColor2$ + LineBar$,0)                       ' 1.03
  120.      CALL ANSILocate (RowMid + 1,3)                                  ' 1.10
  121.      CALL QuickTPut (MenuColor2$ + "░" + ZSysopFirstName$ + _       ' 1.03
  122.           " " + ZSysopLastName$ + "░",0)                            ' 1.03
  123.      CALL ANSILocate (RowMid + 1,43)                                 ' 1.10
  124.      CALL QuickTPut (MenuColor2$ + "░" + ZActiveUserName$ + "░",0) ' 1.03
  125.      CALL Line25
  126.      END SUB
  127. '
  128. 5000 SUB ClearANSIScreen
  129. '
  130.      CALL QuickTPut ("",0)                                       ' 1.03
  131.      ZSubParm = 2
  132.      CALL Line25
  133.      ZSubParm = 0
  134.      CALL ANSILocate (1,1)
  135.      END SUB
  136. '
  137. 6000 SUB ANSILocate (ANSIRow,ANSICol)
  138. '
  139.      CALL QuickTPut ("" + MID$(STR$(ANSIRow),2) + ";" + _
  140.           MID$(STR$(ANSICol),2) + "H",0)
  141.      END SUB
  142. '
  143. 8000 SUB SplitScreenChat
  144. '
  145. 8001 HoldInput$(LocalOut) = ""                                       ' 1.01
  146.      HoldInput$(RemoteOut) = ""
  147.      MaxLen = ColMax - 2                                             ' 1.10
  148.      StartRow(LocalOut) = 2
  149.      StartRow(RemoteOut) = RowMid + 2                                ' 1.10
  150.      MaxRow(LocalOut) = RowMid                                       ' 1.10
  151.      MaxRow(RemoteOut) = RowMax                                      ' 1.10
  152.      ANSICol(LocalOut) = 1
  153.      ANSICol(RemoteOut) = 1
  154.      ANSIRow(LocalOut) = StartRow(LocalOut) + 1
  155.      ANSIRow(RemoteOut) = StartRow(RemoteOut)
  156.      WasX$(LocalOut) = ""
  157.      WasX$(RemoteOut) = ""
  158.      ZWaitExpired = ZFalse
  159. '
  160. 8010 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  161.      CALL Carrier
  162.      IF ZSubParm < 0 THEN _
  163.         EXIT SUB
  164. '
  165. 8020 CALL FindFKey
  166.      IF ZWasCM = 0 THEN _                                            ' 1.01
  167.         CALL FlushCom (ZCommPortStack$) : _                          ' 1.01
  168.         ZKeyPressed$ = "" : _                                        ' 1.01
  169.         CALL ANSIMenu : _                                            ' 1.01
  170.         ZWasCM = ZTrue : _                                           ' 1.01
  171.         GOTO 8001                                                    ' 1.01
  172.      SideOut = LocalOut
  173.      WasX$(LocalOut) = ZKeyPressed$
  174.      IF ZKeyPressed$ = ZEscape$ THEN _
  175.         EXIT SUB
  176.      IF WasX$(LocalOut) <> "" THEN _
  177.         GOTO 8060
  178. '
  179. 8030 IF ZLocalUser THEN _
  180.         GOTO 8010
  181.      SideOut = RemoteOut
  182.      IF ZCommPortStack$ <> "" THEN _
  183.         WasX$(RemoteOut) = LEFT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  184.         GOTO 9000
  185.      CALL EofComm (Char)
  186.      IF Char <> -1 THEN _
  187.         GOTO 8050 _
  188.      ELSE _
  189.         GOTO 8010
  190. '
  191. 8050 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  192.      CALL GetCom (WasX$(RemoteOut))
  193. '
  194. 8060 'Control keys
  195.      LastChar$(SideOut) = RIGHT$(LastChar$(SideOut),1) + _           ' 1.10
  196.                           WasX$(SideOut)                             ' 1.10
  197.      IF WasX$(SideOut) = CHR$(8) THEN _
  198.         GOTO 8500 _
  199.      ELSE IF WasX$(SideOut) = CHR$(9) THEN _
  200.         GOTO 8510 _
  201.      ELSE IF WasX$(SideOut) = CHR$(13) THEN _
  202.         GOTO 8520
  203.      GOTO 9000
  204. '
  205. 8500 'BackSpace
  206.      IF HoldInput$(SideOut) <> "" THEN _                             ' 1.07
  207.         HoldInput$(SideOut) = LEFT$(HoldInput$(SideOut), _           ' 1.07
  208.                               LEN(HoldInput$(SideOut))-1)            ' 1.07
  209.      IF ANSICol(SideOut) > 1 THEN _
  210.         ANSICol(SideOut) = ANSICol(SideOut) - 1 : _                  ' 1.07
  211.         GOTO 8501                                                    ' 1.07
  212.      IF ANSICol(SideOut) = 1 THEN _                                  ' 1.07
  213.         GOSUB 8502 : _                                               ' 1.07
  214.         ANSICol(SideOut) = MaxLen - 1 : _                            ' 1.07
  215.         ANSIRow(SideOut) = ANSIRow(SideOut) - 1                      ' 1.03
  216.      IF ANSIRow(SideOut) < StartRow(SideOut) THEN _                  ' 1.07
  217.         ANSIRow(SideOut) = MaxRow(SideOut)                           ' 1.07
  218. 8501 GOSUB 8502                                                      ' 1.07
  219.      GOTO 8010
  220. 8502 CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))             ' 1.07
  221.      IF NOT ZLocalUser THEN _                                        ' 1.07
  222.         CALL PutCom (" ")                                            ' 1.07
  223.      CALL LPrnt (" ",0)                                              ' 1.07
  224.      CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))             ' 1.07
  225.      RETURN                                                          ' 1.07
  226. '
  227. 8510 'TAB
  228.      HoldInput$(SideOut) = ""
  229.      IF ANSICol(SideOut) + 5 > MaxLen THEN _
  230.         CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) _
  231.      ELSE _
  232.         ANSICol(SideOut) = ANSICol(SideOut) + 5 : _
  233.         CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
  234.      GOTO 8010
  235. '
  236. 8520 'CR
  237.      HoldInput$(SideOut) = ""
  238.      CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
  239.      GOTO 8010
  240. '
  241. 9000 'Character Placement
  242.      IF LastChar$(SideOut) = ZEscape$ + ZEscape$ THEN _              ' 1.10
  243.            EXIT SUB
  244.      HoldInput$(SideOut) = HoldInput$(SideOut) + WasX$(SideOut)
  245.      IF WasX$(SideOut) = " " THEN _
  246.         HoldInput$(SideOut) = ""
  247.      IF ANSICol(SideOut) = MaxLen AND WasX$(SideOut) <> " " THEN _
  248.         CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut) - _
  249.                          LEN(HoldInput$(SideOut))) : _
  250.         CALL QuickTput(ACColor$(SideOut) + "", 0) : _             ' 1.08
  251.         CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) : _
  252.         CALL QuickTPut (HoldInput$(SideOut),0) : _
  253.         ANSICol(SideOut) = ANSICol(SideOut) + LEN(HoldInput$(SideOut)) - 1 : _
  254.         WasX$(SideOut) = "" : _
  255.         HoldInput$(SideOut) = ""
  256.      CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
  257.      IF NOT ZLocalUser THEN _
  258.         CALL PutCom (ACColor$(SideOut) + WasX$(SideOut))
  259.      CALL LPrnt (ACColor$(SideOut) + WasX$(SideOut),0)
  260.      ANSICol(SideOut) = ANSICol(SideOut) + 1
  261.      IF ANSICol(SideOut) > MaxLen THEN _
  262.         CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
  263.      WasX$(SideOut) = ""
  264.      GOTO 8010
  265.      END SUB
  266. '
  267. 10000 SUB AddRow (StartRow,MaxRow)
  268. '
  269.       ANSICol(SideOut) = 1
  270.       ANSIRow(SideOut) = ANSIRow(SideOut) + 1
  271.       IF ANSIRow(SideOut) > MaxRow THEN _
  272.          ANSIRow(SideOut) = StartRow
  273.       IF ANSIRow(SideOut) < MaxRow THEN _
  274.          CALL ANSILocate (ANSIRow(SideOut) + 1,ANSICol(SideOut)) : _
  275.          CALL QuickTput("", 0)
  276.       IF ANSIRow(SideOut) = MaxRow THEN _
  277.          CALL ANSILocate (StartRow,ANSICol(SideOut)) : _
  278.          CALL QuickTput("", 0)
  279.       CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
  280.       END SUB
  281. '
  282. 11000 SUB GetUserScreenSize                                          ' 1.10
  283. '
  284.       ColMax = 80
  285.       RowMax = 24
  286.       RowMid = RowMax \ 2
  287.       IF ZLocalUser THEN _
  288.          EXIT SUB
  289.       CALL FlushCom (Strng$)
  290.       CALL PutCom ("CCBn")
  291.       CALL GetUserCursorLoc (RowMax, ColMax)
  292.       IF ColMax > 80 THEN _
  293.          ColMax = 80
  294.       IF RowMax > 24 THEN _
  295.          RowMax = 24
  296.       RowMid = RowMax \ 2
  297.       END SUB
  298. '
  299. 11100 SUB GetUserCursorLoc (Row, Col)                                ' 1.10
  300. '
  301.       Call ReadString ("R",ZTestANSITime,Response$)
  302.       Temp = INSTR(Response$,"")
  303.       IF Temp > 0 THEN _
  304.          SemiPtr =INSTR(Temp,Response$,";") : _
  305.          IF (SemiPtr > 0) THEN _
  306.             Temp2 = INSTR(SemiPtr,Response$,"R") : _
  307.             IF (Temp2 > 0) THEN _
  308.                Row = VAL(MID$(Response$,Temp+2,SemiPtr-1)) : _
  309.                Col = VAL(MID$(Response$,SemiPtr+1,Temp2-1))
  310.       END SUB
  311. '
  312. 11200 SUB ReadString (Wait$, DelayTime,Response$)                    ' 1.10
  313. '
  314.       Response$ = ""
  315.       TempElapsed! = 0
  316.       Delay! = TIMER
  317.       WHILE (INSTR(Strng$,Wait$) = 0) AND (TempElapsed < DelayTime)
  318.          CALL FlushCom (Strng$)
  319.          Response$ = Response$ + Strng$
  320.          CALL CheckTime (Delay!, TempElapsed!, 2)
  321.       WEND
  322.       END SUB
  323.